;;; $Id: wfc.sld 68 2012-07-20 04:15:12Z alan.watson.f $

(define-library (oaxaca wfc)

  (export wfc-initialized?
          wfc-command
          wfc-idle!
          wfc-trigger!
          wfc-run-free!
          wfc-modal?
          wfc-set-modal!
          wfc-voltages
          wfc-set-voltages!
          wfc-modes
          wfc-set-modes!
          wfc-cycle
          wfc-benchmark-run-free!
          wfc-benchmark-trigger!)

  (import (scheme base)
          (scheme char)
          (scheme time))

  (import (prefix (oaxaca foreign) foreign:)
          (oaxaca log)
          (oaxaca thread))

  (begin

    (define (wfc-initialized?)
      (not (zero? (foreign:wfc-initialized))))

    (define (wfc-idle!)
      (wfc-command! #\i #\I)
      (values))

    (define (wfc-trigger!)
      (wfc-command! #\t #\I)
      (values))

    (define (wfc-run-free!)
      (wfc-command! #\r #\R)
      (values))

    (define (wfc-command)
      (foreign:wfc-command))

    (define (wfc-command! command acknowledgement)
      (unless (wfc-initialized?)
        (error "the wfc is not initialized."))
      (foreign:wfc-set-command! command)
      (thread-wait-until!
       (lambda ()
         (char=? (foreign:wfc-command) acknowledgement)))
      (values))
      
    (define (wfc-modal?)
      (if (zero? (foreign:wfc-modal)) #f #t))
      
    (define (wfc-set-modal! value)
      (foreign:wfc-set-modal! (if value 1 0)))        

    (define (wfc-voltages)
      (let ((voltages (make-vector 64 0.0)))
        (do ((i 0 (+ i 1)))
            ((= i 64))
          (vector-set! voltages i (foreign:wfc-voltage i)))
        voltages))

    (define (wfc-set-voltages! v)
      (unless (= (vector-length v) 64)
        (error "must specify 64 voltages."))
      (do ((i 0 (+ i 1)))
          ((= i 64))
        (foreign:wfc-set-voltage! i (inexact (vector-ref v i))))
      (wfc-set-modal! #f)
      (wfc-trigger!)
      (values))

    (define (wfc-modes)
      (let ((modes (make-vector 2 0.0)))
        (do ((i 0 (+ i 1)))
            ((= i 2))
          (vector-set! modes i (foreign:wfc-mode i)))
        modes))

    (define (wfc-set-modes! v)
      (unless (= (vector-length v) 2)
        (error "must specify 2 mode amplitudes."))
      (do ((i 0 (+ i 1)))
          ((= i 2))
        (foreign:wfc-set-mode! i (inexact (vector-ref v i))))
      (wfc-set-modal! #t)
      (wfc-trigger!)
      (values))

    (define (wfc-cycle)
      (foreign:wfc-cycle))

    (define (benchmark! p)
      (let ((start-second (current-second))
            (start-cycle (wfc-cycle)))
        (p start-second start-cycle)
        (let ((end-second (current-second))
              (end-cycle (wfc-cycle)))
          (wfc-idle!)
          (/ (- end-cycle start-cycle) (- end-second start-second)))))

    (define (wfc-benchmark-run-free! interval)
      (wfc-run-free!)
      (benchmark!
       (lambda (start-second start-cycle)
         (thread-sleep! interval))))

    (define (wfc-benchmark-trigger! interval)
      (let ((v (make-vector 64 0)))
        (wfc-idle!)
        (benchmark!
         (lambda (start-second start-cycle)
           (let loop ()
             (wfc-set-voltages! v)
             (thread-sleep! 20e-6)
             (if (< (current-second) (+ start-second interval))
               (loop)))))))))
